home *** CD-ROM | disk | FTP | other *** search
/ Internet Toolkit / Internet Toolkit.iso / info / lumberja / ircclient.pl next >
Perl Script  |  1993-04-05  |  5KB  |  252 lines
  1. #!/guest/ckd/bin.sun4/perl -- # -*-Perl-*-
  2.  
  3. require 'sys/socket.ph';
  4.  
  5. package ircclient;
  6.  
  7. # the basics for making CLIENT connections to an irc socket
  8. # *NOT* a parser, just the sending code.  Parsers are easy.
  9.  
  10. sub bindsocket {        # bind a socket
  11.     local($sockname,$target,$port) = @_;
  12.     local($sockaddr,$name,$aliases,$proto,$type,$len,
  13.       $thisaddr,$thataddr,$this,$that,$savfh,$hostname);
  14.         
  15.     $sockaddr = 'S n a4 x8';
  16.     chop($hostname = `hostname`);
  17.     $sockname =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
  18.     
  19.     ($name, $aliases, $proto) = getprotobyname('tcp');
  20.     ($name, $aliases, $port) = getservbyname($port, 'tcp')
  21.     unless $port =~ /^\d+$/;;
  22.     ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
  23.     ($name, $aliases, $type, $len, $thataddr) = gethostbyname($target);
  24.     
  25.     $this = pack($sockaddr, &main'AF_INET, 0, $thisaddr);
  26.     $that = pack($sockaddr, &main'AF_INET, $port, $thataddr);
  27.     
  28.     socket($sockname, &main'PF_INET, &main'SOCK_STREAM, $proto) ||
  29.     die "socket $sockname: $!";
  30.     bind($sockname, $this) || die "bind $sockname: $!";
  31.     connect($sockname, $that) || die "connect $sockname: $!";
  32.     $savfh = select($sockname); $| = 1; select($savfh);
  33.     $socket = $sockname;
  34. }
  35.  
  36. sub admin {
  37.     local($target) = @_;
  38.  
  39.     send($socket,"ADMIN $target\n",0);
  40. }
  41.  
  42. sub away {
  43.     local($message) = @_;
  44.     $message = " :$message" if $message;
  45.     send($socket,"AWAY$message\n",0);
  46. }
  47.  
  48. sub channel {
  49.     local($channel) = @_;
  50.  
  51.     send($socket,"CHANNEL $channel\n",0);
  52. }
  53.  
  54. sub connect {
  55.     local($toserver, $port, $fromserver) = @_;
  56.  
  57.     send($socket, "CONNECT $toserver $port $fromserver\n",0);
  58. }
  59.  
  60.  
  61. sub deoper {
  62.     send($socket, "DEOPER\n",0);
  63. }
  64.  
  65. sub die {
  66.     send($socket, "DIE\n",0);
  67. }
  68.  
  69. sub info {
  70.     local($target) = @_;
  71.  
  72.     send($socket,"INFO $target\n",0);
  73. }
  74.  
  75. sub invite {
  76.     local($target,$channel) = @_;
  77.     send($socket, "INVITE $target $channel\n",0);
  78. }
  79.  
  80. sub join {
  81.     local($channel) = @_;
  82.     send($socket, "JOIN $channel\n",0);
  83. }
  84.  
  85. sub kick {
  86.     local($channel,$target) = @_;
  87.     send($socket, "KICK $channel $target\n",0);
  88. }
  89.  
  90. sub kill {
  91.     local($target,$comment) = @_;
  92.     send($socket, "KILL $target $comment\n",0);
  93. }
  94.  
  95. sub links {
  96.     local($mask) = @_;
  97.     send($socket, "LINKS $mask\n",0);
  98. }
  99.  
  100. sub list {
  101.     local($channel) = @_;
  102.     send($socket, "LIST $channel\n",0);
  103. }
  104.  
  105. sub lusers {
  106.     send($socket, "LUSERS\n",0);
  107. }
  108.  
  109. sub mode {
  110.     local($channel,$mode) = @_;
  111.     send($socket, "MODE $channel $mode\n",0);
  112. }
  113.  
  114. sub motd {
  115.     local($target) = @_;
  116.  
  117.     send($socket, "MOTD $target\n",0);
  118. }
  119.  
  120. sub msg {
  121.     local(@strings)=@_;
  122.     foreach(@strings){
  123.     send($socket,"MSG :$_\n",0);
  124.     }
  125. }
  126.  
  127. sub names {
  128.     local($channel) = @_;
  129.     send($socket, "NAMES $channel\n",0);
  130. }
  131.  
  132. sub nick {
  133.     local($target)=@_;
  134.     send($socket, "${srcstring}NICK $target\n",0);
  135. }
  136.  
  137. sub notice {
  138.     local($target,@strings)=@_;
  139.     foreach(@strings){
  140.     send($socket,"NOTICE $target :$_\n",0);
  141.     }
  142. }
  143.  
  144. sub oper {
  145.     local($name,$passwd) = @_;
  146.  
  147.     send($socket,"OPER $name $passwd\n",0);
  148. }
  149.  
  150. sub part {
  151.     local($channel)=@_;
  152.     send($socket, "PART $channel\n",0);
  153. }
  154.  
  155. sub pong {
  156.     local($target)=@_;
  157.     send($socket, "PONG $target\n",0);
  158. }
  159.  
  160. sub privmsg {
  161.     local($target,@strings)=@_;
  162.     foreach(@strings){
  163.     send($socket,"PRIVMSG $target :$_\n",0);
  164.     }
  165. }
  166.  
  167. sub quit {
  168.     send($socket, "QUIT\n",0);
  169. }
  170.  
  171. sub quote {
  172.     send($socket,"@_\n", 0);
  173. }
  174.  
  175. sub squit {
  176.     local($target)=@_;
  177.     send($socket, "SQUIT $target\n",0);
  178. }
  179.  
  180. sub stats {
  181.     local($target,$flags)=@_;
  182.     send($socket, "STATS $flags $target\n",0);
  183. }
  184.  
  185. sub summon {
  186.     local($target) = @_;
  187.  
  188.     send($socket, "SUMMON $target\n",0);
  189. }
  190.  
  191. sub time {
  192.     local($target) = @_;
  193.  
  194.     send($socket, "TIME $target\n",0);
  195. }
  196.  
  197. sub topic {
  198.     local($string)=@_;
  199.     send($socket, "TOPIC $string\n",0);
  200. }
  201.  
  202. sub trace {
  203.     local($target)=@_;
  204.     send($socket, "TRACE $target\n",0);
  205. }
  206.  
  207. sub user {
  208.     local($username,$machine,$server,$fullname)=@_;
  209.     send($socket, "USER $username $machine $server $fullname\n",0);
  210. }
  211.  
  212. sub users {
  213.     local($target)=@_;
  214.     send($socket, "USERS $target\n",0);
  215. }
  216. sub version {
  217.     local($target)=@_;
  218.     send($socket, "VERSION $target\n",0);
  219. }
  220.  
  221. sub voice {
  222.     local($target,$string)=@_;
  223.     send($socket,"VOICE $target :$string\n",0);
  224. }
  225.  
  226. sub wall {
  227.     local($string)=@_;
  228.     send($socket,"WALL $string\n",0);
  229. }
  230.  
  231. sub wallops {
  232.     local($string)=@_;
  233.     send($socket,"WALLOPS $string\n",0);
  234. }
  235.  
  236. sub who {
  237.     local($mask) = @_;
  238.     send($socket,"WHO $mask\n",0);
  239. }
  240.  
  241. sub whois {
  242.     local($mask) = @_;
  243.     send($socket,"WHOIS $mask\n",0);
  244. }
  245.  
  246. sub whowas {
  247.     local($mask) = @_;
  248.     send($socket,"WHOWAS $mask\n",0);
  249. }
  250.  
  251. 1;                # so require works right.
  252.